{-# LANGUAGE TypeInType #-}

-- | Module: Data.Vector.Sized.Sort
-- Copyright: (c) 2018 Koz Ross
-- Maintainer: Koz Ross <koz.ross@retro-freedom.nz>
-- Stability: Experimental
-- Portability: Non-portable 
--
-- A range of implementations of sorting algorithms. These return sorted copies; see
-- "Data.Vector.Mutable.Sized.Sort" for mutable versions of each of these.
-- = Koz's guide to choosing a sorting algorithm
--
-- The number of different sorting algorithms, with different behaviours and use
-- cases, can be overwhelming, especially if you're not an expert. To help you
-- along, I've written this short guide to help your choices. Obviously, don't
-- let this discourage you from trying other options, and the only way to be
-- sure you're making the right choice performance-wise is to profile.
--
-- == Comparison or not?
--
-- A comparison uses the 'Ord' instance methods of the element type to
-- perform the sort directly. These can be used to sort anything which admits an
-- 'Ord' instance, but due to frustrating
-- laws of the universe, can't be done in linear time in general; to be exact, a
-- simple combinatorial argument shows that no comparison sort can be better
-- than \(\Omega(n \log(n))\) for an array of \(n\) elements. 
--
-- For some kinds of element, we can do better, and use a non-comparison sort,
-- which runs in linear time. This relies on certain additional properties of
-- these elements, which are represented by valid 'Lexicographic', 'Radix' or
-- 'Sorting' instances for that element's type. These are typically types which
-- have a fixed width (such as 'Int'), have a structure like a \'string\' over
-- some \'alphabet\' (such as 'Data.ByteString'), or have some other structural
-- regularity. 
--
-- In general, as your arrays get bigger, if you can sort using a non-comparison
-- sort, you should. For smaller arrays, the overheads of non-comparison sorting
-- might overwhelm any benefit you'd otherwise get.
--
-- == "I just want a \'good\' sort, Koz!"
--
-- If you don't really know what you're after or what kind of elements you'll
-- have, 'introSort' is a good choice; it has good performance on a wide range
-- of arrays and elements. There is a (tiny) chance that you'll get
-- quadratic behaviour from it, but it's usually not worth worrying about.
--
-- == "But comparisons for my elements are expensive!"
--
-- In this case, consider 'timSort', which is designed to minimize the number of
-- comparisons it needs to perform.
--
-- == "My arrays will be really small - like, ten elements or so."
--
-- 'insertionSort' could be a good choice, despite its quadratic performance,
-- due to its low overheads. Only make this choice if you are __really__ sure
-- that you won't have more than about twenty elements, as for anything much
-- larger, a different sort is likely going to be faster.
--
-- == "Which non-comparison sort is best?"
--
-- Depends on what you mean by \'best\'. If you mean \'most general\', 
-- 'discriminantSort' is what you want, as 'Sorting' has the largest number of 
-- pre-defined instances (and definable) instances. However, writing your own 'Sorting' 
-- instances can be a bit challenging. If instead you mean \'easiest to define
-- for my type\', you probably want 'radixSort', as 'Radix' instances a easy to
-- write relative 'Lexicographic' and 'Sorting'. 
--
-- If, on the off chance, your goal is to sort an array of 'ByteString', then
-- 'americanFlagSort' is your friend.
--
-- == "I am an expert and I need [insert property here]."
--
-- Check the documentation for each algorithm - I have tried to provide as much
-- useful information as possible in the form of links.
module Data.Vector.Sized.Sort
  ( Comparison
  -- * Comparison sorts
  -- ** Insertion sort
  , insertionSort
  , insertionSortBy
  , insertionSortOn
  -- ** Introsort
  , introSort
  , introSortBy
  , introSortOn
  -- ** Mergesort
  , mergeSort
  , mergeSortBy
  , mergeSortOn
  -- ** Timsort
  , timSort
  , timSortBy
  , timSortOn
  -- * Non-comparison sorts
  -- ** American Flag sort
  , americanFlagSort
  , americanFlagSortBy
  , Lexicographic
  -- ** Discriminant sort
  , discriminantSort
  , discriminantSortOn
  , Sorting
  -- ** Radix sort
  , radixSort
  , radixSortBy
  , Radix
  ) where

import Control.Monad.Primitive
import Control.Monad.ST
import Data.Coerce
import Data.Discrimination
import Data.Function
import Data.Functor.Contravariant
import Data.Vector.Algorithms.AmericanFlag (Lexicographic)
import Data.Vector.Algorithms.Radix (Radix)
import GHC.TypeNats

import qualified Data.Vector.Algorithms.AmericanFlag as AF
import qualified Data.Vector.Algorithms.Insertion as I
import qualified Data.Vector.Algorithms.Intro as IS
import qualified Data.Vector.Algorithms.Merge as M
import qualified Data.Vector.Algorithms.Radix as R
import qualified Data.Vector.Algorithms.Tim as T
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable.Sized as VGMS
import qualified Data.Vector.Generic.Sized as VGS
import qualified Data.Vector.Mutable.Sized.Sort as VMSS

-- | Returns a sorted copy using American flag sort. This is an in-place,
-- [unstable](https://en.wikipedia.org/wiki/Sorting_algorithm#Stability) bucket sort, 
-- which inspects its values in big-endian order, and the
-- buckets are ordered by recursive splitting. For more information, see McIlroy
-- and Bostic's ["Engineering radix
-- sort"](http://static.usenix.org/publications/compsystems/1993/win_mcilroy.pdf).
--
-- As this is not a [comparison
-- sort](https://en.wikipedia.org/wiki/Comparison_sort), it can run in linear
-- time. However, it requires a 'Lexicographic' instance, or equivalent
-- functionality, to be defined for the element type. It is particularly useful 
-- for sorting strings in lexicographic order, provided that the strings can be
-- indexed efficiently.
-- 
-- __Complexity:__ \(O(n)\)
{-# INLINE americanFlagSort #-}
americanFlagSort ::
     (KnownNat n, Lexicographic a, Ord a, VG.Vector v a)
  => VGS.Vector v n a
  -> VGS.Vector v n a
americanFlagSort vec = runST (unpackMutable AF.sort vec)

-- | Fine-grained version of 'americanFlagSort'.
--
-- __Complexity:__ \(O(n)\)
{-# INLINE americanFlagSortBy #-}
americanFlagSortBy ::
     (KnownNat n, VG.Vector v a)
  => Comparison a -- ^ Comparison for insertion sort fallback
  -> (a -> Int -> Bool) -- ^ Is a stripe complete?
  -> Int -- ^ Number of buckets necessary.
  -> (Int -> a -> Int) -- ^ Big-endian radix function.
  -> VGS.Vector v n a
  -> VGS.Vector v n a
americanFlagSortBy comp strip buckets radix vec =
  runST (unpackMutable (AF.sortBy (coerce comp) strip buckets radix) vec)

-- | Returns a sorted copy using insertion sort. 
-- Insertion sort is inefficient, but has low overheads, which makes it suitable
-- for sorting small arrays (ten or twenty elements at most). If your inputs are
-- likely to be larger than this, a different sort should be used. This sort is
-- [stable](https://en.wikipedia.org/wiki/Sorting_algorithm#Stability).
-- 
-- __Complexity:__ \(O(n^{2})\)
{-# INLINE insertionSort #-}
insertionSort ::
     (KnownNat n, Ord a, VG.Vector v a) => VGS.Vector v n a -> VGS.Vector v n a
insertionSort vec = runST (unpackMutable I.sort vec)

-- | As 'insertionSort', but with a custom Comparison.
{-# INLINE insertionSortBy #-}
insertionSortBy ::
     (KnownNat n, VG.Vector v a)
  => Comparison a
  -> VGS.Vector v n a
  -> VGS.Vector v n a
insertionSortBy comp vec = runST (unpackMutable (I.sortBy (coerce comp)) vec)

-- | As 'insertionSort', using a \'projection\' to determine ordering.
{-# INLINE insertionSortOn #-}
insertionSortOn ::
     (KnownNat n, Ord b, VG.Vector v a)
  => (a -> b)
  -> VGS.Vector v n a
  -> VGS.Vector v n a
insertionSortOn f vec = runST (unpackMutable (I.sortBy go) vec)
  where
    go = coerce (compare `on` f)

-- | Returns a sorted copy using introsort. The implementation is based on Musser's
-- ["Introspective Sorting and Selection
-- Algorithms"](http://www.cs.rpi.edu/~musser/gp/introsort.ps). The
-- implementation makes the following optimizations:
--
-- 1. Small segments of the array are left unsorted until a final insertion sort
-- pass. 
-- 2. The pivot for segment \([\ell, u)\) is chosen as the median of the
-- elements at \(\ell, u - 1, \frac{\ell + u}{2}\).
-- 3. If recursion depth reaches \(2 \cdot \log(n)\), switch to a heap sort.
--
-- This is a good general-purpose sort. However, it is not
-- [stable](https://en.wikipedia.org/wiki/Sorting_algorithm#Stability), and in
-- rare cases, can produce \(\Theta(n^{2})\) behaviour.
--
-- __Complexity:__ \(O(n \log(n))\)
{-# INLINE introSort #-}
introSort ::
     (KnownNat n, Ord a, VG.Vector v a) => VGS.Vector v n a -> VGS.Vector v n a
introSort vec = runST (unpackMutable IS.sort vec)

-- | As 'introSort', but with a custom 'Comparison'.
{-# INLINE introSortBy #-}
introSortBy ::
     (KnownNat n, VG.Vector v a)
  => Comparison a
  -> VGS.Vector v n a
  -> VGS.Vector v n a
introSortBy comp vec = runST (unpackMutable (IS.sortBy (coerce comp)) vec)

-- | As 'introSort', with a \'projection\' to determine ordering.
{-# INLINE introSortOn #-}
introSortOn ::
     (KnownNat n, Ord b, VG.Vector v a)
  => (a -> b)
  -> VGS.Vector v n a
  -> VGS.Vector v n a
introSortOn f vec = runST (unpackMutable (IS.sortBy go) vec)
  where
    go = coerce (compare `on` f)

-- | Returns a sorted copy using top-down mergesort, using a temporary, shared buffer array of
-- length \(\lceil \frac{n}{2} \rceil\). 
--
-- Mergesort achieves \(\Omega(n \log(n))\) performance in the worst case, and
-- is also a [stable](https://en.wikipedia.org/wiki/Sorting_algorithm#Stability)
-- sort. However, it requires \(\Theta(n)\) space overhead, which can be
-- impractical for large arrays. If worst-case performance guarantees or sort
-- stability aren't required, a different general-purpose sort (such as
-- introsort or Timsort) are likely going to be better in practice.
--
-- __Complexity:__ \(O(n \log(n))\)
{-# INLINE mergeSort #-}
mergeSort ::
     (KnownNat n, Ord a, VG.Vector v a) => VGS.Vector v n a -> VGS.Vector v n a
mergeSort vec = runST (unpackMutable M.sort vec)

-- | As 'mergeSort', but with a custom Comparison.
{-# INLINE mergeSortBy #-}
mergeSortBy ::
     (KnownNat n, VG.Vector v a)
  => Comparison a
  -> VGS.Vector v n a
  -> VGS.Vector v n a
mergeSortBy comp vec = runST (unpackMutable (M.sortBy (coerce comp)) vec)

-- | As 'mergeSort', using a \'projection\' to determine ordering.
{-# INLINE mergeSortOn #-}
mergeSortOn ::
     (KnownNat n, Ord b, VG.Vector v a)
  => (a -> b)
  -> VGS.Vector v n a
  -> VGS.Vector v n a
mergeSortOn f vec = runST (unpackMutable (M.sortBy go) vec)
  where
    go = coerce (compare `on` f)

-- | Returns a sorted copy using radix sort. For more details, please see
-- 'Data.Vector.Algorithms.Radix'.
--
-- This sort requires a 'Radix' instance, or equivalent functionality, to be
-- defined for the element type. Additionally, it has \(O(n)\) space overhead,
-- as well as a constant based on the element type. It is not
-- [stable](https://en.wikipedia.org/wiki/Sorting_algorithm#Stability).
--
-- __Complexity:__ \(O(n)\)
{-# INLINE radixSort #-}
radixSort ::
     (KnownNat n, Radix a, VG.Vector v a)
  => VGS.Vector v n a
  -> VGS.Vector v n a
radixSort vec = runST (unpackMutable R.sort vec)

-- | Radix sort with custom parameters
{-# INLINE radixSortBy #-}
radixSortBy ::
     (KnownNat n, VG.Vector v a)
  => Int
  -> Int
  -> (Int -> a -> Int)
  -> VGS.Vector v n a
  -> VGS.Vector v n a
radixSortBy p as r vec = runST (unpackMutable (R.sortBy p as r) vec)

-- | Returns a sorted copy using Timsort. For details on the implementation, see the
-- documentation for 'Data.Vector.Algorithms.Tim' and [this revised
-- description](https://hg.python.org/cpython/file/tip/Objects/listsort.txt) by
-- Tim Peters.
--
-- This sort is designed to minimize comparisons, and is thus good for sorting
-- vectors of data for which comparisons are expensive (strings, variable-length
-- structures, and so on). For fixed-length or simple values, other sorts
-- (including some of the linear sorts in this module, for certain types) are
-- more efficient. Timsort is [stable](https://en.wikipedia.org/wiki/Sorting_algorithm#Stability).
--
-- __Complexity:__ \(O(n \log(n))\)
{-# INLINE timSort #-}
timSort ::
     (KnownNat n, Ord a, VG.Vector v a) => VGS.Vector v n a -> VGS.Vector v n a
timSort vec = runST (unpackMutable T.sort vec)

-- | As 'timSort', but with a custom 'Comparison'.
{-# INLINE timSortBy #-}
timSortBy ::
     (KnownNat n, VG.Vector v a)
  => Comparison a
  -> VGS.Vector v n a
  -> VGS.Vector v n a
timSortBy comp vec = runST (unpackMutable (T.sortBy (coerce comp)) vec)

-- | As 'timSort', using a \'projection\' to determine ordering.
{-# INLINE timSortOn #-}
timSortOn ::
     (KnownNat n, Ord b, VG.Vector v a)
  => (a -> b)
  -> VGS.Vector v n a
  -> VGS.Vector v n a
timSortOn f vec = runST (unpackMutable (T.sortBy go) vec)
  where
    go = coerce (compare `on` f)

-- | Returns a sorted copy using a stable, ordered discriminator. For details,
-- see 'Data.Discrimination'.
--
-- This is the most general non-comparison sort. However, it has significant
-- overheads, which may make it inefficient for small arrays. It also requires
-- an instance of 'Sorting'.
--
-- __Complexity:__ \(O(n)\)
{-# INLINE discriminantSort #-}
discriminantSort ::
     (KnownNat n, Sorting a, VG.Vector v a)
  => VGS.Vector v n a
  -> VGS.Vector v n a
discriminantSort vec =
  runST
    (do v <- VGMS.unsafeNew
        VGS.copy v vec
        VMSS.discriminantSort v
        VGS.unsafeFreeze v)

-- | As 'discriminantSort', using a \'projection\' to determine the
-- discriminator.
{-# INLINE discriminantSortOn #-}
discriminantSortOn ::
     (KnownNat n, Sorting b, VG.Vector v a)
  => (a -> b)
  -> VGS.Vector v n a
  -> VGS.Vector v n a
discriminantSortOn f vec =
  runST
    (do v <- VGMS.unsafeNew
        VGS.copy v vec
        VMSS.discriminantSortOn f v
        VGS.unsafeFreeze v)

-- Helper to wrap 'unpacking' into mutable arrays
{-# INLINE unpackMutable #-}
unpackMutable ::
     (KnownNat n, PrimMonad m, VG.Vector v a)
  => (VG.Mutable v (PrimState m) a -> m ())
  -> VGS.Vector v n a
  -> m (VGS.Vector v n a)
unpackMutable f vec = do
  v <- VGMS.unsafeNew
  VGS.copy v vec
  let w = VGMS.fromSized v
  f w
  VGS.unsafeFreeze v
